home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / SystemCode / fill.tcl < prev    next >
Text File  |  1996-08-15  |  12KB  |  402 lines
  1. ####################################################################
  2. # 
  3. # Much by Vince Darley.
  4. # 
  5. #                                    created: 3/7/95 {7:49:47 pm} 
  6. #                                last update: 16/5/96 
  7. #  Author: Vince Darley
  8. #  E-mail: <mailto:vince@das.harvard.edu>
  9. #    mail: Division of Applied Sciences, Harvard University
  10. #          Oxford Street, Cambridge MA 02138, USA
  11. #     www: <http://www.fas.harvard.edu/~darley/>
  12. #  
  13. ####################################################################
  14.  
  15. ## 
  16.  # Here's a    brief explanation of the smart fillParagraph routines
  17.  # 
  18.  # 'fillParagraph'
  19.  #       If there's a    selection, then    fill all paragraphs    in that
  20.  #       selection. If not then fill the paragraph surrounding the
  21.  #       insertion point.    The    definition of a    'paragraph'    may    be
  22.  #       mode    dependent (see paraStart, paraFinish)
  23.  #       
  24.  # 'fillOneParagraph'
  25.  #       Fills the single    paragraph surrounding the insertion    point.
  26.  #       If called with parameter    '0', it    doesn't    bother to remember
  27.  #       where the insertion point was, which    makes multiple paragraph
  28.  #       fills quicker when called by    'fillParagraph'
  29.  #       
  30.  # 'rememberWhereYouAre'
  31.  #       Given the start of a    paragraph and the point    to remember,
  32.  #       this    creates    a record stored    in '__g_remember_pos' so that
  33.  #       the following function can find that    spot later,    even after
  34.  #       the paragraph has had space/tabs/new-lines meddled with.
  35.  #       
  36.  # 'goBackToWhereYouWere'
  37.  #       Given the beginning and end of a    selection, where the beginning
  38.  #       corresponds to a    previous call of 'rememberWhereYouAre',    this
  39.  #       procedure will move the insertion point to the correct place.
  40.  #       
  41.  # 'texParaCommands'
  42.  #       A variable containing the bulk of a regexp for paragraph
  43.  #       indicators in 'TeX' mode.
  44.  #       
  45.  # 'paraStart'
  46.  #       Finds the start of the paragraph    containing the insertion point.
  47.  #       
  48.  # 'paraFinish'
  49.  #       Finds the end of    the    paragraph containing the insertion point.
  50.  ##
  51.     
  52. proc fillParagraph {} {
  53.     if {[getPos] == [selEnd]} {
  54.         fillOneParagraph
  55.     } else {    
  56.         set start [getPos]
  57.         set end [selEnd]
  58.         set p $start
  59.         while { $p < $end && $p < [maxPos]} {
  60.             goto $p
  61.             set p [fillOneParagraph 0]
  62.         }
  63.         goto $start
  64.     }
  65. }
  66.  
  67. proc rememberWhereYouAre { startPara pos } {
  68.     global __g_remember_str
  69.     set srem [expr $pos -20 < $startPara ? $startPara : $pos - 20]
  70.     set __g_remember_str [quoteExpr2 [getText $srem $pos ] ]
  71.     regsub -all "¥[ ¥t¥r¥]+" $__g_remember_str {[ ¥t¥r]+} __g_remember_str
  72. }
  73.  
  74. proc goBackToWhereYouWere { start end } {
  75.     global __g_remember_str
  76.     if { $__g_remember_str != "" } {
  77.         regexp -indices ".*(${__g_remember_str}).*" [getText $start $end] wholematch submatch
  78.         goto [expr $start + 1 + [lindex $submatch 1]]
  79.     } else {
  80.         goto $start
  81.     }
  82. }
  83.  
  84. ## 
  85.  # -------------------------------------------------------------------------
  86.  #     
  87.  #    "getLeadingIndent" --
  88.  #    
  89.  #     Find the indentation of the line containing 'pos',    and    convert    it
  90.  #     to    a minimal form of tabs followed    by spaces.    If 'size'
  91.  #     is    given, then    the    variable of    that name is set to    the    length of
  92.  #     the indent. Similarly 'halftab' can be set to half a tab.
  93.  # -------------------------------------------------------------------------
  94.  ##
  95. proc getLeadingIndent { pos {size ""} {halftab ""} } {
  96.     # get the leading whitespace of the current line
  97.     set res [search -s -n -f 1 -r 1 "^¥[ ¥t¥]*" [lineStart $pos]]
  98.     
  99.     # convert it to minimal form: tabs then spaces, stored in 'front'
  100.     getWinInfo a
  101.     set sp [string range "              " 1 $a(tabsize) ]
  102.     regsub -all $sp [eval getText $res] "¥t" front
  103.     regsub -all "¥[ ¥]+¥t" $front "¥t" front
  104.     if { $size != "" } {
  105.         upvar $size ind
  106.         # get the length of the indent
  107.         regsub -all "¥t" $front $sp lfront
  108.         set ind [string length $lfront]
  109.     }
  110.  
  111.     if { $halftab != "" } {
  112.         upvar $halftab ht
  113.         # get the length of half a tab
  114.         set ht [string range "            " 1 [expr $a(tabsize)/2]]
  115.     }
  116.     
  117.     return $front
  118. }
  119.  
  120. proc fillOneParagraph { {remember 1} } {
  121.     global leftFillColumn fillColumn doubleSpaces
  122.  
  123.     set pos [getPos]
  124.     
  125.     set start [paraStart $pos] 
  126.     set end [paraFinish $pos]
  127.     if $remember { rememberWhereYouAre $start $pos }
  128.  
  129.     # Get the leading whitespace of the current line and store length in 'left'
  130.     set front [getLeadingIndent $pos left]
  131.     # fill the text
  132.     regsub -all "¥[ ¥t¥r¥]+" [string trim [getText $start $end]] " " text
  133.     # turn single spaces at end of sentences into double
  134.     if {$doubleSpaces} {regsub -all {(([^A-Z@]|¥¥@)[.?!]("|'|'')?([])])?) } $text {¥1  } text}
  135. #     if {$doubleSpaces} {regsub -all {(([^A-Z@]|¥¥@)[.?!][])'"]?) } $text {¥1  } text}
  136.  
  137.     # temporarily adjust the fillColumns
  138.     set ol $leftFillColumn
  139.     set or $fillColumn
  140.     set leftFillColumn 0
  141.     set fillColumn [expr $fillColumn - $left]
  142.         
  143.     # break and indent the paragraph
  144.     regsub -all "¥r" "¥r[string trimright [breakIntoLines $text]]" "¥r${front}" text
  145.     
  146.     # don't replace if nothing's changed
  147.     if { "$text¥r" != "¥r[getText $start $end]" } {
  148.         replaceText $start $end "[string range "$text" 1 end]¥r"
  149.         if $remember { goBackToWhereYouWere $start [expr $start + [string length $text]] }
  150.     }
  151.     
  152.     set leftFillColumn $ol
  153.     set fillColumn  $or
  154.     # in case we wish to fill a region
  155.     return $end
  156. }
  157.  
  158.  
  159. ## 
  160.  # -------------------------------------------------------------------------
  161.  # 
  162.  #    "paraStart"    -- "paraFinish"
  163.  # 
  164.  #     Newly simplified version with fewer regexp    '()' pairs.    Also I think
  165.  #     it    deals better with TeX comments than    the    old    regexp.
  166.  #     
  167.  #     "Start": It's pretty clear    for    non    TeX    modes how this works.  The only    
  168.  #     key is    that we    start at the beginning of the current line and look    back.  
  169.  #     We    then have a    quick check    for    whether    we found that very beginning (in 
  170.  #     which case    return it) or if not (in which case we have found the end of 
  171.  #     the previous paragraph) we move forward a line.
  172.  # 
  173.  #     "Finish": The only    addition is    the    need for an    additional check for
  174.  #     stuff which explicitly    ends lines.
  175.  #       
  176.  #    Results:
  177.  #     The start/finish position of the paragraph containing the given 'pos'
  178.  # 
  179.  # --Version--Author------------------Changes-------------------------------
  180.  #      1.1      <vince@das.harvard.edu> Cut down on '()' pairs
  181.  #    1.2     Vince - March '96          Better filling for TeX tables ('hline')
  182.  #    1.3     Johan Linde - May '96   Now sensitive to HTML elements
  183.  # -------------------------------------------------------------------------
  184.  ##
  185. proc paraStart {pos} {
  186.     global mode texParaCommands htmlParaCommands
  187.     if {$pos == [maxPos]} {incr pos -1}
  188.     set pos [lineStart $pos]
  189.     if { $mode == "TeX" || $mode == "Bib" } {
  190.         set startPara {^[ ¥t]*$|¥¥¥¥[ ¥t]*$|%.*$|¥¥h+line[ ¥t]*$|¥$¥$[ ¥t]*$|^[ ¥t]*(¥¥(}
  191.         append startPara $texParaCommands {)(¥[.*¥]|¥{.*¥}|･)*[ ¥t]*)+$}
  192.     } elseif {$mode == "HTML"} {
  193.         set startPara {^[ ¥t]*$|</?(}
  194.         append startPara $htmlParaCommands {)([ ¥t¥r]+[^>]*>|>)}
  195.     } else {
  196.         set startPara {^([ ¥t]*|([¥¥%].*))$}
  197.     }
  198.     set res [search -s -n -f 0 -r 1 -l 0 "$startPara" $pos]
  199.     if {![string length $res] || $res == "0 0" } {return 0}
  200.     if { [lindex $res 0] == $pos } {
  201.         return $pos
  202.     } else {
  203.         return [nextLineStart [lindex $res 0]]
  204.     }
  205.     
  206. }
  207.  
  208. set texParaCommands {¥[|¥]|begin|end|(protect¥¥)?label|(sub)*section|subfigure|paragraph|centerline|centering|caption|chapter|item|bibitem|intertext}
  209. set htmlParaCommands {html|head|title|body|h[1-6]|p|div|blockquote|center|address|pre}
  210. append htmlParaCommands {|br|hr|wbr|basefont|ul|ol|li|dir|menu|dl|dd|dt|form|input}
  211. append htmlParaCommands {|select|option|textarea|caption|table|tr|frameset|frame|noframes}
  212. append htmlParaCommands {|map|area|applet|param|script|base|link|meta|isindex}
  213.  
  214. proc paraFinish {pos} {
  215.     global mode texParaCommands htmlParaCommands
  216.     set pos [lineStart $pos]
  217.     set end [maxPos]
  218.     if { $mode == "TeX" || $mode == "Bib" } {
  219.         set endPara {^[ ¥t]*$|¥$¥$[ ¥t]*$|^[ ¥t]*(¥¥(}
  220.         append endPara $texParaCommands {)(¥[.*¥]|¥{.*¥}|･)*[ ¥t]*)+$}
  221.     } elseif {$mode == "HTML"} {
  222.         set endPara {^[ ¥t]*$|</?(}
  223.         append endPara $htmlParaCommands {)([ ¥t¥r]+[^>]*>|>)}
  224.     } else {
  225.         set endPara {^([ ¥t]*|([¥¥%].*))$}
  226.     }
  227.     
  228.     set res [search -s -n -f 1 -r 1 -l $end "$endPara" $pos]
  229.     if {![string length $res]} {return $end}
  230.     set cpos [lineStart [lindex $res 0] ]
  231.     if { $cpos == $pos } {
  232.         return [nextLineStart $cpos]
  233.     }
  234.     # A line which ends in '¥¥', '%...', '¥hline', '¥hhline'
  235.     # signifies the end of the current paragraph in TeX mode
  236.     # (the above checked for beginning of the next paragraph).
  237.     if { $mode == "TeX" || $mode == "Bib" } {
  238.         set res2 [search -s -n -f 1 -r 1 -l $end {((¥¥¥¥|¥¥h+line)[ ¥t]*|%.*)$} $pos]
  239.         if [string length $res2] {
  240.             if { [lindex $res2 0] < $cpos } {
  241.                 return [nextLineStart [lindex $res2 0]]
  242.             }
  243.         }
  244.     }
  245.  
  246.     return $cpos
  247.     
  248. }
  249.  
  250.  
  251. proc sentenceParagraph {} {
  252.     set pos [getPos]
  253.     set start [paraStart $pos] 
  254.     set finish [paraFinish $pos]
  255.  
  256.     set t [string trim [getText $start $finish]]
  257.     set period [regexp {¥.$} $t]
  258.     regsub -all "¥[ ¥t¥r¥]+" $t " " text
  259.     regsub -all {¥. } $text "ﾆ" text
  260.     set result ""
  261.     foreach line [split [string trimright $text {.}] "ﾆ"] {
  262.         if {[string length $line]} {
  263.             append result [breakIntoLines $line] ".¥r"
  264.         }
  265.     }
  266.     if {!$period && [regexp {¥.¥r} $result]} {
  267.         set result [string trimright $result ".¥r"]
  268.         append result "¥r"
  269.     }
  270.     if {$result != [getText $start $finish]} {
  271.         replaceText $start $finish $result
  272.     }
  273.     goto $pos
  274. }
  275.  
  276. proc getEndpts {} {
  277.     if {[getPos] == [selEnd]} {
  278.         set start [getPos]
  279.         set finish [getMark]
  280.         if {$start > $finish} {
  281.             set temp $start
  282.             set start $finish
  283.             set finish $temp
  284.         }
  285.     } else {
  286.         set start [getPos]
  287.         set finish [selEnd]
  288.     }
  289.     return [list $start $finish]
  290. }
  291.  
  292.  
  293. proc fillRegion {} {
  294.     global leftFillColumn
  295.     set ends [getEndpts]
  296.     set start [lineStart [lindex $ends 0]]
  297.     set finish [lindex $ends 1]
  298.     goto $start
  299.     set text [fillText $start $finish]
  300.     replaceText $start $finish [format "%$leftFillColumn¥s" ""] $text "¥r"
  301. }
  302.     
  303. proc wrapParagraph {} {
  304.     set pos [getPos]
  305.     set start [paraStart $pos] 
  306.     set finish [paraFinish $pos]
  307.     goto $start
  308.     wrapText $start $finish
  309.     goto $pos
  310. }
  311.  
  312. proc wrapRegion {} {
  313.     set ends [getEndpts]
  314.     set start [lineStart [lindex $ends 0]]
  315.     set finish [lindex $ends 1]
  316.     if {$start == $finish} {
  317.         set finish [maxPos]
  318.     }
  319.     wrapText $start $finish
  320. }
  321.     
  322.  
  323.  
  324. # Remove text from window, transform, and insert back into window.
  325. proc fillText {from to} {
  326.     global doubleSpaces
  327.     set text [getText $from $to]
  328.     regexp {^ *} $text front
  329.     set text [string trim $text]
  330.     regsub -all "¥[ ¥t¥r¥]+" $text " " text
  331.     if {$doubleSpaces} {regsub -all {(¥.|¥?|¥!) } $text {¥1  } text}
  332.     regsub -all "¥r" [string trimright [breakIntoLines $text]] "¥r${front}" text
  333.     return $front$text
  334. }
  335.  
  336. proc paragraphToLine {} {
  337.     global fillColumn
  338.     global leftFillColumn
  339.     set fc $fillColumn
  340.     set lc $leftFillColumn
  341.     set fillColumn 10000
  342.     set leftFillColumn 0
  343.     fillRegion
  344.     set fillColumn $fc
  345.     set leftFillColumn $lc
  346. }
  347.  
  348. proc lineToParagraph {} {
  349.     global fillColumn
  350.     global leftFillColumn
  351.     set fc $fillColumn
  352.     set fillColumn 75
  353.     set lc $leftFillColumn
  354.     set leftFillColumn 0
  355.     fillRegion
  356.     set fillColumn $fc
  357.     set leftFillColumn $lc
  358. }
  359.  
  360.  
  361. #set sentEnd {[.!?](¥r| +)}
  362. set sentEnd {(¥r¥r|[.!?](¥r| +))}
  363. set sentBeg {[¥r ][A-Z]}
  364.  
  365. proc nextSentence {} {
  366.     global sentBeg sentEnd
  367.     if {![catch {search -s -f 1 -r 1 $sentEnd [getPos]} mtch]} {
  368.         if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  369.             goto [expr [lindex $mtch 0]+1]
  370.         }
  371.     }
  372. }
  373.  
  374.  
  375. proc prevSentence {} {
  376.     global sentBeg sentEnd
  377.     if {[catch {search -s -f 0 -r 1 $sentBeg [expr [getPos]-2]} mtch]} return
  378.     if {![catch {search -s -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
  379.         if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  380.             goto [expr [lindex $mtch 0]+1]
  381.         }
  382.     }
  383. }
  384. # 5 730 845 955
  385.  
  386. #===============================================================================
  387. # Called by Alpha to do "soft wrapping"
  388. proc softProc {pos start next} {
  389.     global leftFillColumn
  390.     goto $start
  391.     set finish [paraFinish $start]
  392.     set text [fillText $start $finish]
  393.     if {"${text}¥r" != [getText $start $finish]} {
  394.         replaceText $start $finish [format "%$leftFillColumn¥s" ""] $text "¥r"
  395.         return 1
  396.     } else {
  397.         return 0
  398.     }
  399. }
  400.  
  401.  
  402.